Fuente de los datos: Kaggle - Argentina provincial data
# Importamos las bibliotecas necesarias para el análisis.
library(readr)
library(dplyr)
library(FactoMineR)
library(psych)
library(factoextra)
library(corrplot)
library(PerformanceAnalytics)
library(ggplot2)
library(plotly)
library(philentropy)
library(viridis)
library(cluster)
library(pheatmap)
library(NbClust)
options(scipen = 6) # para evitar notacion cientifica.
datos <- read_csv("argentina.csv")
# Eliminamos la columna "provincia" y renombramos las columnas para mayor claridad
datos <- subset(datos, select = -c(1))
colnames(datos) <- c("pbi", "analfabetismo", "pobreza", "infraestructura_deficiente", "abandono_escolar", "falta_atencion_medica", "mortalidad_infantil", "poblacion", "cines_por_cada_habitante", "medicos_por_cada_habitante")
View(summarise_all(datos, funs(sum(is.na(.)))))
# datos <- na.omit(datos) # Eliminamos las filas con valores nulos en caso de haber
Convertimos todas las columnas a tipo numérico para asegurarnos de que sean interpretables.
attach(datos)
datos <- datos %>% mutate_all(as.numeric)
summary(datos) # Estadísticas descriptivas
## pbi analfabetismo pobreza
## Min. : 3807057 Min. :0.7915 Min. : 3.399
## 1st Qu.: 8041587 1st Qu.:1.9898 1st Qu.: 7.473
## Median : 10964161 Median :2.7437 Median : 9.142
## Mean : 30557028 Mean :3.2255 Mean : 9.926
## 3rd Qu.: 19994520 3rd Qu.:3.6862 3rd Qu.:12.500
## Max. :292689868 Max. :7.5176 Max. :17.036
## infraestructura_deficiente abandono_escolar falta_atencion_medica
## Min. : 3.84 Min. :0.2041 Min. :29.23
## 1st Qu.: 7.57 1st Qu.:0.8126 1st Qu.:45.55
## Median :10.87 Median :1.4378 Median :49.37
## Mean :12.68 Mean :1.7249 Mean :50.77
## 3rd Qu.:16.10 3rd Qu.:2.5145 3rd Qu.:56.92
## Max. :31.48 Max. :3.8643 Max. :65.81
## mortalidad_infantil poblacion cines_por_cada_habitante
## Min. : 0.800 Min. : 273964 Min. :0.000001816
## 1st Qu.: 3.025 1st Qu.: 514372 1st Qu.:0.000004052
## Median : 4.000 Median : 777530 Median :0.000005768
## Mean : 4.986 Mean : 1686352 Mean :0.000007144
## 3rd Qu.: 5.875 3rd Qu.: 1230606 3rd Qu.:0.000009314
## Max. :16.200 Max. :15625084 Max. :0.000018812
## medicos_por_cada_habitante
## Min. :0.002821
## 1st Qu.:0.004061
## Median :0.004757
## Mean :0.004894
## 3rd Qu.:0.005334
## Max. :0.010175
Creamos un boxplot para visualizar la distribución de los datos cuantitativos.
pbi_boxplot <- plot_ly(y = ~datos$pbi , type = "box")
pbi_boxplot
rm(pbi_boxplot) # Limpiamos la variable utilizada para el gráfico
Visualización con índice de correlación para cada atributo
datos_cor <- cor(datos) # Calculamos y almacenamos las correlaciones
corrplot(datos_cor, method = "number", tl.col = "black", tl.cex = 0.8)
Utilizamos el test de Bartlett y el índice KMO para evaluar si es adecuado el ACP.
cortest.bartlett(cor(datos), n = 22) # Test de Bartlett
## $chisq
## [1] 174.209
##
## $p.value
## [1] 4.224723e-17
##
## $df
## [1] 45
KMO(cor(datos)) # Índice KMO
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = cor(datos))
## Overall MSA = 0.62
## MSA for each item =
## pbi analfabetismo
## 0.42 0.72
## pobreza infraestructura_deficiente
## 0.76 0.58
## abandono_escolar falta_atencion_medica
## 0.52 0.81
## mortalidad_infantil poblacion
## 0.50 0.39
## cines_por_cada_habitante medicos_por_cada_habitante
## 0.70 0.76
cp <- prcomp(datos, scale = TRUE) # Realizamos el ACP
summary(cp) # Resumen de los resultados del ACP
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.112 1.3937 1.0207 0.96656 0.85134 0.62258 0.47134
## Proportion of Variance 0.446 0.1942 0.1042 0.09342 0.07248 0.03876 0.02222
## Cumulative Proportion 0.446 0.6402 0.7444 0.83785 0.91033 0.94909 0.97131
## PC8 PC9 PC10
## Standard deviation 0.39233 0.3605 0.05515
## Proportion of Variance 0.01539 0.0130 0.00030
## Cumulative Proportion 0.98670 0.9997 1.00000
# Los elementos center y scale almacenan la media y desviación de las variables originales
cp$center
## pbi analfabetismo
## 3.055703e+07 3.225541e+00
## pobreza infraestructura_deficiente
## 9.925625e+00 1.267730e+01
## abandono_escolar falta_atencion_medica
## 1.724866e+00 5.076884e+01
## mortalidad_infantil poblacion
## 4.986364e+00 1.686352e+06
## cines_por_cada_habitante medicos_por_cada_habitante
## 7.143952e-06 4.893720e-03
cp$scale
## pbi analfabetismo
## 6.183100e+07 1.851496e+00
## pobreza infraestructura_deficiente
## 3.779530e+00 7.216860e+00
## abandono_escolar falta_atencion_medica
## 1.152438e+00 9.181037e+00
## mortalidad_infantil poblacion
## 3.498339e+00 3.219828e+06
## cines_por_cada_habitante medicos_por_cada_habitante
## 4.373885e-06 1.522047e-03
# sdev almacena la desviación de los cp
cp$sdev
## [1] 2.11186901 1.39368466 1.02074522 0.96656356 0.85134127 0.62257860
## [7] 0.47133965 0.39232934 0.36052123 0.05514919
# rotation contiene el valor de los autovalores para cada componente
cp$rotation
## PC1 PC2 PC3 PC4
## pbi -0.1914540 -0.645222596 0.09123813 0.1000753
## analfabetismo 0.4174006 -0.057876459 0.01896060 -0.2159198
## pobreza 0.4059149 -0.084132717 -0.10509906 0.1884898
## infraestructura_deficiente 0.3233987 0.055936339 0.08568284 0.4530471
## abandono_escolar 0.2878699 -0.046207001 0.40002240 -0.5986191
## falta_atencion_medica 0.4055549 -0.175869259 -0.05454735 0.0227362
## mortalidad_infantil 0.2382665 -0.010191598 0.72485856 0.3110493
## poblacion -0.1506956 -0.671198374 0.06552957 0.1121580
## cines_por_cada_habitante -0.3260043 0.293983846 0.35549244 0.3375115
## medicos_por_cada_habitante -0.2943905 0.005312217 0.39223268 -0.3470974
## PC5 PC6 PC7 PC8
## pbi 0.010566157 -0.1307891 -0.06939491 -0.04041271
## analfabetismo 0.227062030 -0.2423201 0.41310632 -0.66626336
## pobreza -0.287513572 0.4308760 -0.22617018 -0.37955085
## infraestructura_deficiente 0.572082798 -0.2822477 -0.51800988 0.03706082
## abandono_escolar -0.201562429 -0.3968361 -0.29005127 0.19227694
## falta_atencion_medica 0.317350069 0.1457354 0.53292276 0.55189281
## mortalidad_infantil -0.284366712 0.2617941 0.11278007 0.07649538
## poblacion -0.007152771 -0.1039049 0.04094142 -0.08461152
## cines_por_cada_habitante -0.001421260 -0.3703624 0.33527883 -0.16265817
## medicos_por_cada_habitante 0.562256454 0.5134578 -0.10048125 -0.16734147
## PC9 PC10
## pbi -0.04825088 0.709012907
## analfabetismo 0.21755026 0.057255769
## pobreza -0.56354548 0.021610387
## infraestructura_deficiente 0.03373231 -0.043624822
## abandono_escolar -0.27569208 -0.037689551
## falta_atencion_medica -0.29842933 0.038737381
## mortalidad_infantil 0.39093221 0.012416079
## poblacion -0.04508010 -0.698709610
## cines_por_cada_habitante -0.53939240 0.004656972
## medicos_por_cada_habitante -0.14405487 -0.018981271
# x almacena los autovectores
cp$x
## PC1 PC2 PC3 PC4 PC5 PC6
## [1,] -2.660550545 -5.59793735 0.06623639 0.95433462 -0.52038350 -0.35251139
## [2,] -0.715231853 0.59003856 -1.27520016 -0.12111140 -0.15550456 0.14403595
## [3,] -2.628376961 -0.22951816 1.62573808 -0.75181498 2.02082720 1.08615378
## [4,] 2.561451503 -0.23625613 0.46371066 -1.04969157 0.24939027 -0.46447879
## [5,] 4.146709774 -0.39025115 0.10612706 0.69953183 1.24441862 -0.49814196
## [6,] -2.169856869 1.27833415 -0.20848324 0.88813528 -0.60620826 -0.54165944
## [7,] 0.004083866 0.24282797 -0.37577669 -0.09690185 0.65297894 -0.67704280
## [8,] 3.996218684 -0.13694614 1.70987976 1.89461214 -0.18040165 0.80953956
## [9,] 0.544405610 0.11303480 -1.38053283 0.51714204 -0.35776438 0.96514661
## [10,] -2.205880536 1.70059507 1.19185595 1.78091596 0.68394382 -0.78606892
## [11,] 0.032316803 0.90759600 2.41076224 -0.54552428 -1.71081118 -0.28086940
## [12,] -1.533823196 0.11242040 -0.05560055 -0.46747332 -0.04199263 0.37235403
## [13,] 2.765924483 -0.45346804 -0.01869171 -0.95906594 -1.17170017 -0.19842081
## [14,] -0.788738297 0.54666931 -0.30304568 0.11148505 -0.04391581 0.07392568
## [15,] -1.011301520 0.74442351 -1.13819252 0.62882972 0.66531206 -0.05762592
## [16,] 1.736966101 -0.25385073 -0.66054893 0.57727871 -0.41849578 1.01810313
## [17,] 0.072695569 0.21414623 0.16979211 -1.64832213 -0.74129863 -0.05069253
## [18,] -0.349115358 0.31297828 -0.04254060 -1.16890481 0.56570190 0.24102064
## [19,] -2.452246002 1.29785556 -0.66218479 0.75695012 -1.15910648 -0.11287155
## [20,] -1.525609528 -0.63108867 0.55844399 -1.24100809 0.42654941 -0.46506387
## [21,] 2.513814722 -0.19301392 -1.36095369 -0.22363399 0.69509431 -1.05510517
## [22,] -0.333856450 0.06141046 -0.82079484 -0.53576312 -0.09663348 0.83027319
## PC7 PC8 PC9 PC10
## [1,] 0.116657072 0.02195952 -0.014982805 -0.02211257413
## [2,] -0.340864281 -0.01684550 0.255574341 -0.01975274394
## [3,] 0.133669902 -0.59011482 -0.137135530 0.00387366639
## [4,] -0.026839046 0.13707297 -0.448438530 -0.06484624257
## [5,] -0.254445828 -0.62899857 -0.017870647 0.00705100373
## [6,] 0.323975887 -0.37580363 -0.517111978 0.07089485971
## [7,] -0.608464171 0.26642251 0.452959066 -0.08790428872
## [8,] -0.265995851 0.43960322 0.398590194 0.03499911969
## [9,] -0.267696219 0.34865334 -0.018127719 -0.01876699206
## [10,] 0.755516230 0.31859349 0.125510439 -0.04492784518
## [11,] -0.313586820 -0.21304363 -0.264772599 -0.05523467283
## [12,] 0.808045625 0.48658107 0.374935806 0.02848321657
## [13,] 0.806019572 -0.51795533 0.524296893 0.06091428205
## [14,] -0.114499844 0.23160480 -0.362354615 0.11706570598
## [15,] -0.019849542 0.16223798 -0.317559952 -0.03566204805
## [16,] -0.008204456 0.05992167 -0.700444481 0.00004797029
## [17,] 0.234035711 0.58655958 -0.303148236 -0.04583784125
## [18,] 0.134928759 0.32119155 0.509606321 0.03493551807
## [19,] -0.658370742 -0.55485645 0.451930716 -0.00254618365
## [20,] -1.066591346 0.19442934 0.008746957 0.09624440452
## [21,] 0.367361761 -0.03508963 -0.126469188 0.02451492709
## [22,] 0.265197627 -0.64212351 0.126265546 -0.08143324171
Visualizamos el gráfico de sedimentación de las componentes.
plot(cp,
type = "l",
main = "Gráfico de sedimentación",
col = c("blue4"))
Vemos el screeplot para decidir cuantas componentes usar
fviz_screeplot(cp, addlabels = TRUE, ylim = c(0, 60),
main = "CP más significativas con Screeplot")
# AJUSTE DE LA TÉCNICA
scree(cor(datos), pc = TRUE)
Realizamos un biplot para visualizar las variables y las observaciones en el espacio de componentes principales.
biplot(x = cp, scale = 0, cex = 0.6, col = c("blue4", "brown3"))
datos_esc <- scale(datos)
mat_dist <- dist(x = datos_esc, method = "euclidean") # Optamos medida de distancias Euclidean
hc_euclidea_average <- hclust(d = mat_dist, method = "average") # Optamos medida de linkeo avg
cor(x = mat_dist, cophenetic(hc_euclidea_average))
## [1] 0.8425647
Visualizamos dendrograma de clustering jerarquico.
fviz_dend(x = hc_euclidea_average, k = 3, cex = 0.6) +
geom_hline(yintercept = 5.5, linetype = "dashed") +
labs(title = "Clustering jerárquico",
subtitle = "Distancia euclidea, Linkage average, k=3")
Visualización de grupos en el plano de las 3 primeras componentes
cutree(hc_euclidea_average, k = 3)
## [1] 1 2 2 3 3 2 2 3 2 2 2 2 3 2 2 2 2 2 2 2 3 2
fviz_cluster(object = list(data = datos, cluster = cutree(hc_euclidea_average, k = 3)),
ellipse.type = "convex", repel = TRUE, show.clust.cent = FALSE,
labelsize = 8) +
labs(title = "Clustering jerárquico + Proyección PCA",
subtitle = "Distancia euclídea, Linkage avg, K=3") +
theme_bw() +
theme(legend.position = "bottom")
hc_diana <- diana(x = mat_dist, diss = TRUE, stand = FALSE)
fviz_dend(x = hc_diana, cex = 0.5) +
labs(title = "Clustering divisivo",
subtitle = "Distancia euclídea")
colores <- viridis(254)
heatmap(x = datos_esc, scale = "none",col = hcl.colors(50), cexRow = 0.7)
kn <- 3 # Número de grupos
pheatmap(mat = datos_esc, scale = "none", clustering_distance_rows = "manhattan",
clustering_distance_cols = "euclidean", clustering_method = "ward.D2",
cutree_rows = kn, fontsize = 8)
km_clusters_2 <- kmeans(x = mat_dist, centers = 3, nstart = 50)
# NÚMERO ÓPTIMO DE CLUSTERS (usando índice de silueta)
fviz_nbclust(x = datos_esc, FUNcluster = kmeans, method = "silhouette", k.max = 11) +
labs(title = "Número óptimo de clusters", diss = mat_dist)
set.seed(101) # Establecemos una semilla para reproducibilidad
fviz_cluster(object = km_clusters_2, data = datos, show.clust.cent = TRUE,
ellipse.type = "euclid", star.plot = TRUE, repel = TRUE) +
labs(title = "Resultados clustering K-means con k=3") +
theme_bw() +
theme(legend.position = "none")
km_clusters <- eclust(x = datos_esc, FUNcluster = "kmeans", k = 3, seed = 123,
hc_metric = "manhattan", nstart = 50, graph = FALSE)
fviz_silhouette(sil.obj = km_clusters, print.summary = TRUE, palette = "jco",
ggtheme = theme_classic())
## cluster size ave.sil.width
## 1 1 15 0.36
## 2 2 1 0.00
## 3 3 6 0.34
Creamos un nuevo dataframe que incluya las dos primeras componentes principales y la asignación de clusters
df <- data.frame(PC1 = cp$x[, 1], PC2 = cp$x[, 2], Cluster = km_clusters_2$cluster)
# Creamos el diagrama de dispersión
ggplot(df, aes(x = PC1, y = PC2, color = factor(Cluster))) +
geom_point(size = 3) +
labs(title = "Diagrama de Dispersión de Componentes Principales",
x = "Componente Principal 1",
y = "Componente Principal 2") +
scale_color_discrete(name = "Cluster") +
theme_minimal()
Estos resultados proporcionan una visión más profunda de la heterogeneidad provincial en Argentina. El ACP ha simplificado la complejidad de los datos al identificar las dimensiones clave, mientras que el clustering ha revelado patrones de agrupación significativos. Esta información es fundamental para la formulación de políticas y la asignación de recursos, ya que destaca las áreas que requieren una atención específica y permite una comprensión más precisa de la diversidad regional en el país.